Ham Radio/Ham Radio CD-ROM (Emerald Software) (1995).ISO/misc/duper/duper.bas

BASIC Source File | 1987-03-15 | 17.0 KB | 447 lines

790 REM        ***  QSO DUPE CHECKING AND SORTING PROGRAM ***
800 REM
810 REM       COPYRIGHT (C) 1985 BY GEORGE ALLISON, K5IJ
820 REM
830 REM      Released to the public domain by the author
840 REM
850 REM    THIS PROGRAM IS PROVIDED ON AN `AS IS' BASIS, WITHOUT
860 REM    WARRANTY OF ANY KIND, EXPRESSED OR IMPLIED, INCLUDING BUT
870 REM    NOT LIMITED TO THE IMPLIED WARRANTY OF FITNESS FOR A
880 REM    PARTICULAR PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND
890 REM    PERFORMANCE OF THIS PROGRAM IS WITH YOU.  SHOULD THE PROGRAM
900 REM    PROVE DEFECTIVE, YOU (NOT K5IJ) ASSUME THE ENTIRE COST OF
910 REM    NECESSARY REPAIR, SERVICING, OR CORRECTION.  IN NO CASE WILL
920 REM    K5IJ BE LIABLE TO YOU FOR ANY DAMAGES, INCLUDING INCIDENTAL
930 REM    OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY
940 REM    TO USE THIS PROGRAM, EVEN IF K5IJ HAS BEEN ADVISED OF THE
950 REM    POSSIBILITY OF SUCH DAMAGES.
960 REM
970 REM      This program can accept a maximum of 500 calls.  For
980 REM   information on how to increase this number, see QST.
990 REM
1000 DIM Q$(500,7),P$(500),SE$(74)    'INITIALIZE MATRICES
1010 GOTO 3540                         'JUMP TO START
1020 REM  *** ALL-CAPS SUBROUTINE ***
1030 IF D=1 THEN V=LEN(Q$(C,D)) ELSE V=3
1040 FOR I=1 TO V
1050 H$=MID$(Q$(C,D),I,1)
1060 IF H$ > "z" OR H$ < "a" THEN GOTO 1080
1070 MID$(Q$(C,D),I,1)=CHR$(ASC(H$)-32)
1080 NEXT I
1090 RETURN
1100 REM *** DATE, TIME AND BAND SUBROUTINE ***
1110 Q$(C,7)=BA$                              'CURRENT BAND
1120 Q$(C,2)=LEFT$(DATE$,6)+RIGHT$(DATE$,2)   'LAST TWO DIGITS OF YEAR
1130 Q$(C,3)=LEFT$(TIME$,5)                   'HOURS AND MINUTES ONLY
1140 LOCATE 15,1
1150 FOR I = 1 TO 8
1160 PRINT STRING$(70," ")
1170 NEXT I
1180 LOCATE 15,3
1190 PRINT "HIS RST   MY RST   COMMENT"
1200 PRINT "  -------   ------   -------"
1210 LOCATE 17,3
1220 INPUT">",Q$(C,4)
1230 LOCATE 17,13
1240 INPUT">",Q$(C,5)
1250 LOCATE 17,22
1260 INPUT">",Q$(C,6)
1270 PRINT:PRINT "   HIT `C' TO CORRECT, ANY KEY TO CONTINUE";
1280 AN$ = INPUT$(1)
1290 IF (AN$="C" OR AN$="c") THEN GOTO 1140
1300 REM *** SECTION CHECKER ***
1310 D = 6              ' INDEX FOR CAPS CORRECTION
1320 GOSUB 1020
1330 D = 1              ' RESET CORRECTION
1340 IF SW$ <> "Y" THEN GOTO 1440
1350 FOR I=0 TO (N-1)
1360 IF SE$(I) <> LEFT$(Q$(C,6)+" ",3) THEN GOTO 1430
1370 N=N-1          ' REDUCE SECTION MATRIX
1380 SF = 1    'SET SECTION CHANGE FLAG
1390 FOR J=I TO (N-1)
1400 SE$(J) = SE$(J+1)
1410 NEXT J
1420 RETURN         ' BREAK EARLY IF MATCH
1430 NEXT I
1440 RETURN
1450 REM *** DISK SAVE SUBROUTINE ***
1460 PRINT:PRINT "  PUT DATA DISK IN DRIVE B AND HIT ANY KEY WHEN READY"
1470 X$=INPUT$(1)
1480 LOCATE 20,45:PRINT"       . . . Saving"
1490 OPEN "O", #1, "B:LOG.DAT"
1500 IF SW$ <> "Y" THEN GOTO 1550
1510 PRINT #1,N
1520 FOR I=0 TO N-1
1530 WRITE #1,SE$(I)      'SAVE SWEEPSTAKES INFO
1540 NEXT I
1550 FOR I=0 TO C-1
1560 FOR J=1 TO 7
1570 WRITE #1, Q$(I,J)
1580 NEXT J
1590 NEXT I
1600 CLOSE
1610 LOCATE 20,45:PRINT TAB(65)
1620 RETURN
1630 REM *** DELETION SUBROUTINE ***
1640 LOCATE 15,3:PRINT TAB(40)
1650 LOCATE 15,3:INPUT "CALLSIGN TO DELETE: ",Q$(C,1)
1660 IF Q$(C,1) = "" THEN GOTO 1640
1670 GOSUB 1020
1680 LOCATE 17,3:INPUT "WHAT BAND? (CR IF BAND NOT IMPORTANT) ",B$
1690 IF B$ > " " THEN GOTO 1770
1700 FOR I=0 TO C-1       'FIND THE CALLSIGN
1710 IF Q$(I,1) = Q$(C,1) THEN GOTO 1850
1720 NEXT I
1730 LOCATE 19,3
1740 PRINT "CALLSIGN ";Q$(C,1);" NOT FOUND.  PRESS ANY KEY TO RESUME"
1750 X$=INPUT$(1)
1760 GOTO 4300
1770 FOR I=0 TO C-1
1780 IF Q$(I,1) = Q$(C,1) AND B$ = Q$(I,7) THEN GOTO 1850
1790 NEXT I
1800 LOCATE 19,3
1810 PRINT "CALLSIGN ";Q$(C,1);" NOT FOUND ON ";B$;" METERS";
1820 PRINT "  PRESS ANY KEY TO RESUME"
1830 X$=INPUT$(1)
1840 GOTO 4390
1850 LOCATE 19,3
1860 PRINT "ARE YOU SURE YOU WANT TO DELETE ";Q$(I,1);" ? (Y/N) ";
1870 AN$ = INPUT$(1)
1880 IF AN$="N" OR AN$="n" THEN GOTO 4390
1890 IF AN$ <> "Y" AND AN$ <> "y" THEN GOTO 1850
1900 LOCATE 19,55:PRINT". . . Deleting"
1910 IF SW$ <> "Y" THEN GOTO 1940
1920 T$ = LEFT$(Q$(I,6),3)         'SAVE SECTION
1930 IF LEN(T$) < 3 THEN T$ = T$ + " "
1940 FOR K=I TO C-1                'DELETE CALLSIGN AND INFO
1950 FOR J=1 TO 7
1960 Q$(K,J) = Q$(K+1,J)
1970 NEXT J
1980 NEXT K
1990 SE$(N) = "Z"
2000 C=C-1
2010 IF SW$ <> "Y" THEN GOTO 2280
2020 FOR I=0 TO 73          'DETERMINE IF SECTION IS VALID
2030 READ SN$
2040 IF T$ = 1
2050 NEXT I
2060 RESTORE
2070 IF C = 0 THEN GOTO 4100   'RESTART IF NO CONTACTS
2080 GOTO 4390     'COMPLETE LOOP IF NOT VALID
2090 FOR I=0 TO C            'DETERMINE IF SECTION WAS WORKED
2100 IF T$ = LEFT$(LEFT$(Q$(I,6)+" ",3),3) THEN GOTO 4390  'WAS WORKED
2110 NEXT I
2120 N=N+1
2130 IF N=1 THEN GOTO 2190
2140 IF T$ > SE$(N-1) THEN SE$(N-1)=T$:GOTO 2280
2150 IF T$ > SE$(0) THEN GOTO 2210
2160 FOR I=N-1 TO 1 STEP -1
2170 SE$(I) = SE$(I-1)
2180 NEXT I
2190 SE$(0) = T$
2200 GOTO 2280
2210 FOR I=0 TO N-2
2220 IF T$ > SE$(I) AND T$ < SE$(I+1) THEN GOTO 2240
2230 NEXT I
2240 FOR J=N-1 TO I+1 STEP -1
2250 SE$(J) = SE$(J-1)
2260 NEXT J
2270 SE$(I+1) = T$
2280 IF C=O THEN GOTO 4100
2290 GOTO 4290
2300 REM *** HEADER SUBROUTINE ***
2310 PRINT "STATION";TAB(13);"BAND";TAB(21);"DATE";TAB(29);"TIME";TAB(36);
2320 PRINT "HIS RST";TAB(45);"MY RST";TAB(53);"COMMENT"
2330 PRINT "----------";TAB(13);"----";TAB(19);"--------";TAB(29);"-----";
2340 PRINT TAB(36);"-------";TAB(45);"------";TAB(53);"---------------"
2350 RETURN
2360 REM *** PRINT SUBROUTINE ***
2370 PRINT Q$(I,1);TAB(14);Q$(I,7);TAB(19);Q$(I,2);TAB(29);Q$(I,3);
2380 PRINT TAB(38);Q$(I,4);TAB(46);Q$(I,5);TAB(53);Q$(I,6)
2390 RETURN
2400 REM *** BUBBLE SORT ***
2410 PRINT:PRINT:PRINT:PRINT " ","   . . . Sorting"
2420 LOCATE 20,35:PRINT "PASS ="
2430 FOR J=0 TO C-1             'REARRANGE CALL FOR PROPER SORTING
2440 IF Q$(J,7)="160" THEN Q$(J,7)="99"     'SORTING CORRECTION
2450 IF LEFT$(Q$(J,1),1) < ":" THEN P$(J)=Q$(J,7)+Q$(J,1):GOTO 2490
2460 IF MID$(Q$(J,1),2,1) > ":" THEN GOTO 2480
2470 P$(J)=Q$(J,7)+Q$(J,1) + "." :GOTO 2490
2480 P$(J)=Q$(J,7)+LEFT$(Q$(J,1),1)+MID$(Q$(J,1),3,1)+MID$(Q$(J,1),4,9)+MID$(Q$(J,1),2,1)
2490 IF Q$(J,7)="99" THEN Q$(J,7)="160"
2500 NEXT J
2510 K=0                         'PASS COUNTER
2520 F=1                         'SORTING FLAG
2530 K=K+1
2540 LOCATE 20,41:PRINT TAB(45)
2550 LOCATE 20,41:PRINT K
2560 FOR I=0 TO (C-2)
2570 IF P$(I) < P$(I+1) THEN GOTO 2630
2580 SWAP P$(I),P$(I+1)
2590 FOR J=1 TO 7
2600 SWAP Q$(I,J),Q$(I+1,J)
2610 NEXT J
2620 F=0                      'SET FLAG IF ANOTHER PASS REQUIRED
2630 NEXT I
2640 IF F=0 THEN GOTO 2520
2650 REM *** DISPLAY SUBROUTINE ***
2660 CLS:PRINT:PRINT:PRINT
2670 PRINT " ","Stations worked as of ";TIME$;" on ";DATE$:PRINT:PRINT
2680 GOSUB 2300
2690 FOR I=0 TO C-1
2700 GOSUB 2360
2710 IF Q$(I,7) <> Q$(I+1,7) THEN PRINT
2720 NEXT I
2730 PRINT:PRINT " ","  TOTAL STATIONS = ";C
2740 REM *** PRINTING SUBROUTINE ***
2750 PRINT:PRINT:PRINT"  DO YOU WANT A HARD COPY PRINTOUT? (Y/N) ";
2760 AN$ = INPUT$(1):PRINT AN$
2770 IF AN$="N"OR AN$="n" THEN GOTO 4250
2780 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 2750
2790 PRINT:PRINT"  CHECK PRINTER IS ON AND PRESS ANY KEY TO START"
2800 X$=INPUT$(1)
2810 LPRINT " ","         * * * * * * * * * * * * *"
2820 LPRINT " ","           S U P ' R   D U P ' R  "
2830 LPRINT " ","         * * * * * * * * * * * * *":LPRINT:LPRINT
2840 LPRINT " ","     Copyright 1985 K5IJ Sup'r Software":LPRINT:LPRINT
2850 LPRINT " ","Stations worked as of ";TIME$;" on ";DATE$
2860 H=44:K=44                   'LINES ON FIRST PAGE
2870 FOR I=0 TO C-1
2880 IF (H/K-INT(H/K)) > .000001 THEN GOTO 2950   'HEADER/FEED CONTROL
2890 REM  *** PAGE HEADER SUBROUTINE ***
2900 IF I=0 THEN GOTO 2930     'FIRST PAGE ONLY
2910 H=55:K=55                 'INITIALIZE NUMBER OF LINES ON PAGE
2920 LPRINT:LPRINT:LPRINT" "," ","   PAGE ";PA:LPRINT CHR$(12)
2930 GOSUB 3010
2940 PA=PA+1
2950 GOSUB 3090
2960 IF Q$(I,7) <> Q$(I+1,7) THEN H=H-1:LPRINT   'BAND SEPARATION
2970 NEXT I
2980 LPRINT:LPRINT " "," ","TOTAL STATIONS =";C
2990 LPRINT CHR$(12)             'FORMFEED
3000 GOTO 4250
3010 REM *** PRINTING HEADER SUBROUTINE ***
3020 LPRINT:LPRINT:LPRINT "STATION";TAB(13);"BAND";TAB(21);"DATE";
3030 LPRINT TAB(29);"TIME";TAB(36);"HIS RST";TAB(45);"MY RST";
3040 LPRINT TAB(53);"COMMENT"
3050 LPRINT "----------";TAB(13);"----";TAB(19);"--------";TAB(29);
3060 LPRINT "-----";TAB(36);"-------";TAB(45);"------";
3070 LPRINT TAB(53);"---------------"
3080 RETURN
3090 REM *** PRINTER SUBROUTINE ***
3100 LPRINT Q$(I,1);TAB(14);Q$(I,7);TAB(19);Q$(I,2);TAB(29);Q$(I,3);
3110 LPRINT TAB(38);Q$(I,4);TAB(46);Q$(I,5);TAB(53);Q$(I,6)
3120 RETURN
3130 REM *** PICK SUBROUTINE ***
3140 FL=0               'COMMENT FLAG
3150 LOCATE 15,3:PRINT TAB(40)
3160 LOCATE 15,3:INPUT "FIELD TO SELECT (X TO EXIT): ",Q$(C,1)
3170 GOSUB 1020
3180 SL$=Q$(C,1)         'SL$ IS SAVED FOR HEADER DISPLAY
3190 IF Q$(C,1)="STATION" THEN PI=1:GOTO 3280       'Q$(C,1) IS A
3200 IF Q$(C,1)="BAND" THEN PI=7:GOTO 3280          'DUMMY VARIABLE
3210 IF Q$(C,1)="DATE" THEN PI=2:GOTO 3280          'SO THE ALL-CAPS
3220 IF Q$(C,1)="TIME" THEN PI=3:GOTO 3280          'SUBROUTINE WILL
3230 IF Q$(C,1)="HIS RST" THEN PI=4:GOTO 3280       'WORK
3240 IF Q$(C,1)="MY RST" THEN PI=5:GOTO 3280
3250 IF Q$(C,1)="COMMENT" THEN FL=1:GOTO 3280
3260 IF Q$(C,1)="X" THEN GOTO 4390
3270 PRINT "  NO SUCH FIELD, TRY AGAIN":GOTO 3150
3280 PRINT:INPUT"  VALUE TO SELECT: ",Q$(C,1)
3290 GOSUB 1020
3300 L=LEN(Q$(C,1))
3310 CLS
3320 PRINT:PRINT " ","SELECTION FOR ";SL$;" = ";Q$(C,1):PRINT
3330 GOSUB 2300
3340 FOR I=0 TO (C-1)
3350 IF FL=0 THEN SO$=Q$(I,PI) ELSE SO$=LEFT$(Q$(I,6),L)
3360 IF SO$ <> Q$(C,1) THEN GOTO 3380
3370 GOSUB 2360
3380 NEXT I
3390 PRINT:PRINT"   SELECTION COMPLETE. DO YOU WANT A HARD COPY? (Y/N) ";
3400 AN$ = INPUT$(1):PRINT AN$
3410 IF AN$="N" OR AN$="n" THEN GOTO 4250
3420 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 3390
3430 PRINT:PRINT"   CHECK PRINTER IS ON AND PRESS ANY KEY TO START"
3440 X$=INPUT$(1)
3450 LPRINT:LPRINT " ","SELECTION FOR ";SL$;" = ";Q$(C,1)
3460 GOSUB 3010
3470 FOR I=0 TO (C-1)
3480 IF FL=0 THEN SO$=Q$(I,PI) ELSE SO$=LEFT$(Q$(I,6),L)
3490 IF SO$ <> Q$(C,1) THEN GOTO 3510
3500 GOSUB 3090
3510 NEXT I
3520 LPRINT:LPRINT:LPRINT
3530 GOTO 4250
3540 REM *** START PROGRAM ***
3550 C=0
3560 FR = FRE(0)/100
3570 N=74
3580 PA=0                         'PAGE NUMBER
3590 D=1
3600 CLS
3610 KEY OFF                      'TURN OFF FUNCTION KEY PROMPTS
3620 PRINT:PRINT:PRINT
3630 PRINT " "," ","* * * * * * * * * * * * *"
3640 PRINT " "," ","  S U P ' R   D U P ' R  "
3650 PRINT " "," ","* * * * * * * * * * * * *":PRINT:PRINT
3660 PRINT " ","       Copyright (C) 1985 K5IJ Sup'r Software":PRINT:PRINT
3670 LOCATE 11,3:PRINT TAB(50)
3680 LOCATE 11,3:PRINT "IS THIS THE SWEEPSTAKES? (Y/N) ";
3690 SW$ = INPUT$(1):PRINT SW$
3700 IF SW$ = "y" THEN SW$ = "Y"
3710 IF SW$ = "N" OR SW$ = "n" THEN GOTO 3730
3720 IF SW$ <> "Y" AND SW$ <> "N" AND SW$ <> "n" THEN GOTO 3670
3730 LOCATE 13,3:PRINT TAB(65):LOCATE 13,3
3740 PRINT "DO YOU WANT ALL-BAND OR SINGLE-BAND DUPE CHECKING? (A/S) ";
3750 SA$ = INPUT$(1):PRINT SA$
3760 IF SA$="s" THEN SA$="S"
3770 IF SA$ <> "S" AND SA$ <> "a" AND SA$ <> "A" THEN GOTO 3730
3780 LOCATE 15,3:PRINT TAB(40):LOCATE 15,3
3790 PRINT "DO YOU WANT AUTO-SAVE? (Y/N) ";
3800 SV$ = INPUT$(1):PRINT SV$
3810 IF SV$ = "y" THEN SV$ = "Y"
3820 IF SV$ <> "N" AND SV$ <> "n" AND SV$ <> "Y" THEN GOTO 3780
3830 LOCATE 17,3:PRINT TAB(50):LOCATE 17,3
3840 PRINT "IS THERE A DISK FILE TO INPUT? (Y/N) ";
3850 AN$ = INPUT$(1):PRINT AN$:PRINT:PRINT
3860 IF AN$="N" OR AN$="n" THEN GOTO 4050
3870 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 3830
3880 PRINT "  PUT DISK WITH FILE <LOG.DAT> IN DRIVE B AND PRESS ANY KEY"
3890 X$=INPUT$(1)
3900 PRINT:PRINT"          . . . Loading"
3910 OPEN "I", #1, "B:LOG.DAT"
3920 IF SW$ <> "Y" THEN GOTO 3970
3930 INPUT #1,N
3940 FOR I=0 TO N-1
3950 INPUT #1,SE$(I)      'LOAD SWEEPSTAKES INFO INTO MEMORY
3960 NEXT I
3970 IF EOF(1) THEN GOTO 4020
3980 FOR J=1 TO 7
3990 INPUT #1, Q$(C,J)        'LOAD DISK FILE INTO MEMORY
4000 NEXT J
4010 C=C+1:GOTO 3970
4020 CLOSE
4030 BA$=Q$(C-1,7)
4040 IF C<>0 THEN GOTO 4250      'CHECK FOR FIRST CALL
4050 IF SW$ <> "Y" THEN GOTO 4100
4060 FOR I=0 TO N-1
4070 READ SE$(I)
4080 NEXT I
4090 RESTORE
4100 CLS
4110 LOCATE 9,3:PRINT TAB(40)
4120 LOCATE 9,3:INPUT "  ENTER BAND: ",BA$
4130 IF BA$ = "" THEN GOTO 4110
4140 IF BA$<>"10" AND BA$<>"15" AND BA$<>"20" AND BA$<>"30"  AND BA$<>"40"  AND BA$<>"80" AND BA$<>"160" THEN PRINT "  ";BA$;"  IS NOT A VALID BAND":GOTO 4110
4150 LOCATE 10,1:PRINT TAB(40):LOCATE 12,3:PRINT TAB(40)
4160 LOCATE 12,3:INPUT "  ENTER FIRST CALL: ",Q$(C,1)
4170 IF Q$(C,1) = "" THEN GOTO 4150
4180 IF LEN(Q$(C,1)) < 12 THEN GOTO 4210
4190 PRINT:PRINT "  CALLSIGN TOO LONG, TRY AGAIN"
4200 GOTO 4150
4210 GOSUB 1020
4220 IF VAL(Q$(C,1)) > 9 THEN GOTO 4100    'JUMP TO START IF BAND ENTERED
4230 GOSUB 1100
4240 C=1
4250 CLS:PRINT
4260 PRINT "  Dele  Pick  SAve  SOrt  View  Quit";TAB(43);
4270 PRINT "BANDS:  10  15  20  30  40  80  160"
4280 PRINT STRING$(79,"-")
4290 IF SW$ <> "Y" THEN GOTO 4430
4300 LOCATE 4,1
4310 PRINT " "," ","SECTIONS NOT WORKED = ";N
4320 IF N=0 THEN PRINT TAB(34) "CLEAN SWEEP!!!":GOTO 4370
4330 FOR I=0 TO N-1
4340 PRINT " ";SE$(I);" ";
4350 NEXT I
4360 PRINT TAB(79) " "
4370 LOCATE 10,1
4380 PRINT STRING$(79,"-")
4390 LOCATE 14,1
4400 FOR I = 1 TO 6
4410 PRINT TAB(70) " "
4420 NEXT I
4430 LOCATE 11,1
4440 PRINT "  ";Q$(C-1,1);" ENTERED AT ";Q$(C-1,3);
4450 PRINT TAB(33)"CONTACTS =";C;TAB(50)INT((FRE(0)/FR)+.5)"% MEM";
4460 PRINT TAB(63)"BAND: ";BA$;" METERS  "
4470 LOCATE 13,1
4480 PRINT TAB(70) " "
4490 LOCATE 13,1
4500 INPUT "  ENTER NEXT CALL: ",Q$(C,1)
4510 IF LEN(Q$(C,1)) < 2 AND Q$(C,1) < "A" THEN GOTO 4470
4520 IF LEN(Q$(C,1)) < 12 THEN GOTO 4550
4530 PRINT:PRINT "  CALLSIGN TOO LONG, TRY AGAIN"
4540 GOTO 4430
4550 GOSUB 1020
4560 IF Q$(C,1)="DELE" OR Q$(C,1)="D" THEN GOTO 1630
4570 IF Q$(C,1)="PICK" OR Q$(C,1)="P" THEN GOTO 3130
4580 IF Q$(C,1)="SAVE" OR Q$(C,1)="SA" THEN GOSUB 1450:GOTO 4390
4590 IF Q$(C,1)="SORT" OR Q$(C,1)="SO" THEN GOTO 2400
4600 IF Q$(C,1)="VIEW" OR Q$(C,1)="V" THEN GOTO 2650
4610 IF Q$(C,1)="QUIT" OR Q$(C,1)="Q" THEN GOTO 4980
4620 IF VAL(Q$(C,1)) <= 9 THEN GOTO 4760     'TEST FOR BAND CHANGE
4630 REM *** BAND CHANGE ROUTINE ***
4640 IF Q$(C,1)="10" THEN BA$ ="10": GOTO 4430
4650 IF Q$(C,1)="15" THEN BA$="15": GOTO 4430
4660 IF Q$(C,1)="20" THEN BA$="20": GOTO 4430
4670 IF Q$(C,1)="30" THEN BA$="30": GOTO 4430
4680 IF Q$(C,1)="40" THEN BA$="40": GOTO 4430
4690 IF Q$(C,1)="80" THEN BA$="80": GOTO 4430
4700 IF Q$(C,1)="160" THEN BA$="160": GOTO 4430
4710 PRINT "  ";Q$(C,1);" IS NOT A BAND -- ENTER AS CALL? (Y/N) ";
4720 AN$ = INPUT$(1):PRINT AN$
4730 IF AN$="N" OR AN$="n" THEN GOTO 4390
4740 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 4710
4750 Q$(C+1,7)=Q$(C,7)
4760 PRINT:PRINT "  . . . Looking"TAB(40):PRINT:PRINT
4770 FOR J=0 TO (C-1)
4780 IF SA$ = "S" THEN GOTO 4800
4790 IF Q$(J,1) <> Q$(C,1) THEN GOTO 4850 ELSE GOTO 4810
4800 IF Q$(J,7)+Q$(J,1)<>BA$+Q$(C,1) THEN GOTO 4850
4810 PRINT " ","DUPE ON "Q$(J,7);" METERS AT ";Q$(J,3);", ";Q$(J,2)
4820 PRINT:PRINT "  PRESS ANY KEY TO CONTINUE"
4830 X$=INPUT$(1)
4840 GOTO 4390
4850 NEXT J
4860 LOCATE 18,3:PRINT TAB(55):LOCATE 18,3
4870 PRINT "NO DUPE FOUND. ENTER CALL IN FILE? (RETURN/Y/N) ";
4880 AN$ = INPUT$(1):PRINT AN$
4890 IF AN$="N" OR AN$="n" THEN GOTO 4390
4900 IF AN$<>"Y" AND AN$<>"y" AND AN$<>CHR$(13) THEN GOTO 4860
4910 SF=0                    'SECTION FLAG
4920 GOSUB 1100
4930 C = C+1                 'ADVANCE COUNTER
4940 IF INT(C/10)<>C/10 THEN GOTO 4960
4950 IF SV$="Y" THEN GOSUB 1480
4960 IF SF=0 THEN GOTO 4390
4970 GOTO 4300
4980 REM *** QUIT/SAVE ROUTINE ***
4990 CLS:PRINT:PRINT:PRINT:PRINT:PRINT
5000 PRINT " ","      *** WARNING  WARNING  WARNING ***":PRINT:PRINT
5010 PRINT:PRINT " ","   IF NOT SAVED, DATA MAY BE LOST FOREVER!":PRINT
5020 PRINT:PRINT:PRINT "  DO YOU WANT TO SAVE THE CALLS? (Y/N) ";
5030 AN$ = INPUT$(1):PRINT AN$
5040 IF AN$="N" OR AN$="n" THEN GOTO 5070
5050 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 5020
5060 GOSUB 1450
5070 PRINT:PRINT "  DO YOU WANT TO CONTINUE? (Y/N) ";
5080 AN$ = INPUT$(1):PRINT AN$
5090 IF AN$="N" OR AN$="n" THEN GOTO 5120
5100 IF AN$<>"Y" AND AN$<>"y" THEN GOTO 5070
5110 GOTO 4250
5120 PRINT:PRINT:PRINT:PRINT " "," ","HAPPY DX-ING":PRINT:PRINT
5130 KEY ON                      'RESTORE SCREEN
5140 REM *** SECTION DATA ***
5150 DATA "AB ","AK ","AL ","AR ","AZ ","BC ","CO ","CT ","DE ","EB "
5160 DATA "EMA","ENY","EPA","GA ","IA ","ID ","IL ","IN ","KS ","KY "
5170 DATA "LA ","LAX","MAR","MB ","MDC","ME ","MI ","MN ","MO ","MS "
5180 DATA "MT ","NC ","ND ","NE ","NFL","NH ","NLI","NM ","NNJ","NTX"
5190 DATA "NV ","OD ","OH ","ON ","OR ","ORG","PAC","PQ ","RI ","SB "
5200 DATA "SC ","SCV","SD ","SDG","SF ","SFL","SJV","SK ","SNJ","STX"
5210 DATA "SV ","TN ","UT ","VA ","VT ","WA ","WI ","WIN","WMA","WNY"
5220 DATA "WPA","WV ","WY ","YNT"
5230 END